home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
CRS
/
crs07.d81
/
scienc2.prg
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2009-10-10
|
12KB
|
472 lines
10 DIM CA$(30),KE$(7,6),YP(7,6),XP(7,6),LU(7,6),HE$(3,25)
15 IA$="0123456789.":IB$="/*-+"
16 RD=180/3.1415927:DR=3.1415927/180
17 X1=0:X2=0:XV$="":XY$="":I$=""
18 DG=1:FC=1:YA=0:XA=0:PR=2:FE =1:FT=1
19 GOSUB 9000
20 CA$(1)="[213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]"
30 CA$(2)="[194]F[213][195][195][195][195][195][195][195][195][195][195][195][195][195][201]D[194]"
40 CA$(3)="[194] [194] [194] [194]"
50 CA$(4)="[194]M[202][195][195][195][195][195][195][195][195][195][195][195][195][195][203]R[194]"
60 CA$(5)="[194] [194]"
70 CA$(6)="[194] 2ND 10X EX [255] [194]"
80 CA$(7)="[194] FNC LOG LN RND [194]"
90 CA$(8)="[194] [194]"
100 CA$(9)="[194] P[209]R S-1 C-1 T-1 [194]"
110 CA$(10)="[194] D[209]R SIN COS TAN [194]"
120 CA$(11)="[194] [194]"
130 CA$(12)="[194] Y1X SQR N! 1/X [194]"
140 CA$(13)="[194] Y^X X^2 CE Y[209]X [194]"
150 CA$(14)="[194] [194]"
160 CA$(15)="[194] 7 8 9 / % F[209]E [194]"
170 CA$(16)="[194] [194]"
180 CA$(17)="[194] 4 5 6 * Y=X ME+ [194]"
190 CA$(18)="[194] [194]"
200 CA$(19)="[194] 1 2 3 - X[209]M +/- [194]"
210 CA$(20)="[194] [194]"
220 CA$(21)="[194] . 0 = + RCL CLR [194]"
230 CA$(22)="[202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]"
240 REM
250 REM
260 REM
270 REM
280 POKE 53280,0:POKE 53281,0:PRINT"[147]"
290 PRINT"[155]";
300 FOR K = 1 TO 22
310 PRINT " ";CA$(K)
320 NEXT K
325 PRINT" PRESS <Q> TO QUIT "
330 KE$(1,1)="2ND[157][157][157]FNC"
340 KE$(1,2)="10X[157][157][157]LOG"
350 KE$(1,3)=" EX[157][157][157] LN"
360 KE$(1,4)=" [255] [157][157][157]RND"
370 KE$(2,1)="P[209]R[157][157][157]D[209]R"
380 KE$(2,2)="S-1[157][157][157]SIN"
390 KE$(2,3)="C-1[157][157][157]COS"
400 KE$(2,4)="T-1[157][157][157]TAN"
410 KE$(3,1)="Y1X[157][157][157]Y^X"
420 KE$(3,2)="SQR[157][157][157]X^2"
430 KE$(3,3)=" N![157][157][157] CE"
440 KE$(3,4)="1/X[157][157][157]Y[209]X"
450 KE$(4,1)="7"
460 KE$(4,2)="8"
470 KE$(4,3)="9"
480 KE$(4,4)="/"
490 KE$(4,5)="%"
500 KE$(4,6)="F[209]E"
510 KE$(5,1)="4"
520 KE$(5,2)="5"
530 KE$(5,3)="6"
540 KE$(5,4)="*"
550 KE$(5,5)="Y=X"
560 KE$(5,6)="ME+"
570 KE$(6,1)="1"
580 KE$(6,2)="2"
590 KE$(6,3)="3"
600 KE$(6,4)="-"
610 KE$(6,5)="X[209]M"
620 KE$(6,6)="+/-"
630 KE$(7,1)="."
640 KE$(7,2)="0"
650 KE$(7,3)="="
660 KE$(7,4)="+"
670 KE$(7,5)="RCL"
680 KE$(7,6)="CLR"
690 REM LOAD SCREEN LOCATION DATA
700 DATA 6,13,1,6,17,2,6,21,3,6,25,4,0,0,4,0,0,4
710 DATA 9,13,1,9,17,2,9,21,3,9,25,4,0,0,4,0,0,4
720 DATA 12,13,1,12,17,2,12,21,3,12,25,4,0,0,4,0,0,4
730 DATA 15,13,1,15,15,2,15,17,3,15,19,4,15,22,5,15,25,6
740 DATA 17,13,1,17,15,2,17,17,3,17,19,4,17,21,5,17,25,6
750 DATA 19,13,1,19,15,2,19,17,3,19,19,4,19,21,5,19,25,6
760 DATA 21,13,1,21,15,2,21,17,3,21,19,4,21,21,5,21,25,6
770 FOR I = 1 TO 7
780 FOR J= 1 TO 6
790 READ YP(I,J),XP(I,J),LU(I,J)
800 NEXT J:NEXT I
805 GOSUB 6850
810 Y=1:X=1
820 POKE 782,13:POKE 781,6:SYS 65520
830 PRINT"";KE$(Y,X);"[146]"
835 POKE 55404,2
836 POKE 781,3:POKE 782,14: SYS65520
837 PRINT"0.00000000000"
840 GOSUB 2000
845 PRINT"[147]":SYS64738
850 END
2000 Y=1:X=1:XV$=""
2010 Y1=Y:X1=X:Q=0:Q1=0
2020 I$=""
2030 GET I$ :IF I$="" THEN GOTO 2030
2040 IF I$= CHR$(17) THEN Y=Y+1:GOSUB 2170:GOTO 2160
2050 IF I$=CHR$(145) THEN Y=Y-1:GOSUB 2170:GOTO 2160
2060 IF I$=CHR$(29) THEN X=X+1:GOSUB 2170:GOTO 2160
2070 IF I$=CHR$(157) THEN X=X-1:GOSUB 2170:GOTO 2160
2080 GOSUB 2350
2090 IF I$="Q" THEN RETURN
2095 IF I$="F" THEN GOSUB 3010:GOTO 2160
2097 IF I$="?" THEN GOSUB 7000: GOTO 2160
2098 IF I$="C" THEN GOSUB 4070:GOTO 2160
2100 IF I$=CHR$(13) THEN GOSUB 5000:GOTO2160
2110 IF Q1 > 0 THEN OP=Q1:GOSUB2500:GOTO2160
2120 IF I$="E" THEN GOTO 2140
2125 IF I$=CHR$(61) THEN GOSUB 2500 :GOTO2160
2130 IF Q=0 THEN GOTO 2160
2140 XV$=XV$+I$
2150 GOSUB 2420
2160 GOTO 2010
2170 IF Y>7 THEN Y=1
2180 IF Y<1 THEN Y=7
2190 IF X>6 THEN X=1
2200 IF X<1 THEN X=6
2210 POKE 782,XP(Y1,LU(Y1,X1))
2220 POKE 781,YP(Y1,LU(Y1,X1))
2230 SYS 65520
2240 PRINT KE$(Y1,LU(Y1,X1))
2250 POKE 782,XP(Y,LU(Y,X))
2260 POKE 781,YP(Y,LU(Y,X))
2270 SYS 65520
2280 PRINT"";KE$(Y,LU(Y,X));"[146]"
2290 RETURN
2340 REM INSTR FNC
2350 FOR KK = 1 TO 11
2360 IF KK>4 THEN GOTO 2380
2370 IF I$=MID$(IB$,KK,1) THEN Q1=KK
2380 IF I$=MID$(IA$,KK,1) THEN Q=KK
2390 NEXT KK:RETURN
2400 REM
2410 REM DISPLAY WHILE INPUTING VAL
2420 DL=LEN(XV$)
2430 IF DL> 13 THEN XV$=LEFT$(XV$,13):GOTO 2420
2440 POKE 781,3:POKE 782,14:SYS 65520
2450 PRINT" ":DL=14+(13-DL)
2460 POKE 781,3:POKE 782,DL:SYS 65520
2470 PRINT XV$
2480 RETURN
2490 REM
2500 XT=0:XT=VAL(XV$):XV$=""
2510 IF XT= 0 THEN GOTO 2610
2520 IF XA= 0 THEN XA=XT: GOTO 2610
2530 X2=XT
2540 ON OP GOSUB 2570,2580,2590,2600
2550 XV$="":X2=0
2560 GOTO 2610
2570 XA=XA/X2:RETURN
2580 XA=XA*X2:RETURN
2590 XA=XA-X2:RETURN
2600 XA=XA+X2:RETURN
2610 XY$=STR$(XA):FL=0:RQ=0:EN=0:PL=0
2615 IF VAL(XY$)=0 THEN XY$="0.00"
2620 FOR I = 1 TO LEN (XY$)
2640 IF MID$(XY$,I,1)="." THEN FL=1:RQ=I
2650 IF MID$(XY$,I,1)="E" THEN EN=1:FE=2
2660 NEXT I
2670 ON FE GOSUB 2690,2750
2680 RETURN
2690 IF LEN(XY$) > 13 AND FL=1 THEN XY$= LEFT$(XY$,13):GOTO 2720
2700 IF FL=0 THEN XY$=XY$+"."
2710 IF LEN (XY$) < 13 THEN XY$=XY$+"0":GOTO 2710
2720 POKE 781,3:POKE 782,14:SYS 65520
2730 PRINT" [157][157][157][157][157][157][157][157][157][157][157][157][157]";XY$
2740 RETURN
2750 IF EN=1 THEN GOTO 2880
2755 IF FL=0 THEN XY$=XY$+".":RQ=LEN(XY$):PL=RQ-2
2760 IF FL=1 THEN PL=RQ-2
2770 LS$=LEFT$(XY$,(RQ-1))
2780 RS$=RIGHT$(XY$,(LEN(XY$)-RQ))
2790 XY$=LS$+RS$
2800 LS$=LEFT$(XY$,2)+"."
2810 RS$=RIGHT$(XY$,(LEN(XY$)-2))
2820 XY$=LS$+RS$
2830 IF LEN(XY$) < 9 THEN XY$=XY$+"0":GOTO 2830
2840 XY$=XY$+"E+"+STR$(PL-1)
2850 POKE781,3:POKE782,14:SYS 65520
2860 PRINT" [157][157][157][157][157][157][157][157][157][157][157][157][157]";XY$
2870 RETURN
2880 LS$= LEFT$(XY$,9)
2890 RS$=RIGHT$(XY$,4)
2900 XY$=LS$+RS$
2910 POKE 781,3:POKE 782,14:SYS 65520
2920 PRINT" [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";XY$
2930 PRINT" [157][157][157][157][157][157][157][157][157][157][157][157][157]";XY$
3000 REM 2ND FNC KEY
3010 FC=FC+1:IF FC >2 THEN FC=1
3020 ON FC GOSUB 3040,3050
3030 RETURN
3040 POKE 55388,1: RETURN
3050 POKE 55388,2:RETURN
3060 REM 10X-LOG KEY
3070 ON FC GOSUB 3090,3100
3080 RETURN
3090 XA=LOG(XA)/LOG(10):RETURN
3100 XA=10^XA:RETURN
3110 REM NATURAL LOG/ANTILOG
3120 ON FC GOSUB 3140, 3150
3130 RETURN
3140 XA=LOG(XA):RETURN
3150 XA=EXP(XA):RETURN
3160 REM PI/RND KEY
3170 ON FC GOSUB 3190, 3200
3180 RETURN
3190 XA=RND(0):RETURN
3200 XA=3.1415927:RETURN
3210 REM P(null)R/D(null)R KEY
3220 ON FC GOSUB 3240, 3300
3230 RETURN
3240 REM
3245 DG=DG+1:IF DG>2 THEN DG=1
3250 ON DG GOSUB 3270,3280
3260 RETURN
3270 XA=XA*RD:YA=YA*RD
3275 POKE 55404,2:POKE 55484,1:RETURN
3280 XA=XA*DR:YA=YA*DR
3285 POKE 55404,1:POKE 55484,2:RETURN
3290 REM POLAR TO RECTANGULAR
3300 PR=PR+1: IF PR> 2 THEN PR=1
3310 ON PR GOSUB 3330,3380
3320 RETURN
3330 TH=YA:RA=XA
3340 IF DG=1 THEN TH=TH*DR
3350 XA=RA*COS(TH)
3360 YA=RA*SIN(TH)
3370 RETURN
3380 RA=SQR(XA^2+YA^2)
3390 TH=ATN(YA/XA)
3400 IF DG=1 THEN TH=TH*RD
3410 XA=RA:YA=TH:RETURN
3420 RETURN
3430 ON FC GOSUB 3450,3470
3440 RETURN
3450 IF DG=1 THEN XA=XA*DR
3460 XA=SIN(XA):RETURN
3470 XA=ATN(XA/SQR(-XA*XA+1))
3480 IF DG=1 THEN XA=XA*RD
3490 RETURN
3500 REM COS/ARCCOSINE
3510 ON FC GOSUB 3530,3550
3520 RETURN
3530 IF DG=1 THEN XA=XA*DR
3540 XA=COS(XA):RETURN
3550 XA=-ATN(XA/SQR(-XA*XA+1))+(3.1415927/2)
3560 IF DG=1 THEN XA=XA*RD
3570 RETURN
3580 REM TAN/ATN
3590 ON FC GOSUB 3610,3630
3600 RETURN
3610 IF DG=1 THEN XA=XA*DR
3620 XA=TAN(XA):RETURN
3630 XA=ATN(XA)
3640 IF DG=1 THEN XA=XA*RD
3650 RETURN
3660 REM XTH ROOT/Y^XTH POWER
3670 ON FC GOSUB 3690,3700
3680 RETURN
3690 XA=YA^XA:RETURN
3700 XA=YA^(1/XA):RETURN
3710 REM SQR/X^2
3720 ON FC GOSUB 3740 , 3750
3730 RETURN
3740 XA=XA^2:RETURN
3750 XA=SQR(XA):RETURN
3760 REM FACTORIAL/CLR ENTRY
3770 ON FC GOSUB 3790,3830
3780 RETURN
3790 XV$=""
3800 POKE 781,3:POKE782,14:SYS 65520
3810 PRINT"0.00000000000"
3820 RETURN
3830 FOR F= INT(XA)-1 TO 1 STEP -1
3840 XA=INT(XA)*F
3850 NEXT F:RETURN
3860 REM RECIPORICAL/SWAP X/Y DISPLAY
3870 ON FC GOSUB 3890,3910
3880 RETURN
3890 TP=XA:XA=YA:YA=TP:
3900 RETURN
3910 XA=1/XA:RETURN
3920 REM PERCENT
3930 XA=XA/100:RETURN
3940 REM Y=X
3950 YA=XA:XA=0:RETURN
3960 REM X(null)M
3970 ME=XA:POKE 55468,2
3980 IF ME=0 THEN POKE 55468,1
3990 RETURN
4000 REM RCL
4010 XA=ME:RETURN
4020 REM ME+
4030 ME=ME+XA:POKE 55468,2:RETURN
4040 REM +/- FUNCTION
4050 XA=XA * -1:RETURN
4060 REM CLR FUNCTION
4070 OP=0:XA=0:YA=0:XV$="":XY$=""
4080 POKE 781,3:POKE 782,14:SYS 65520
4090 PRINT"0.00000000000":RETURN
4100 REM FLOATING POINT TO FIXED NOTATION
4110 FE = FE +1:IF FE>2 THEN FE=1
4120 RETURN
4130 REM = KEY
4140 GOSUB 2500:RETURN
4150 REM OPERATIONS
4160 OP=1:GOTO 4200
4170 OP=2:GOTO 4200
4180 OP=3:GOTO 4200
4190 OP=4
4200 IF LEN (XV$)>0 THEN GOSUB 2500
4205 RETURN
4210 XV$=XV$+"7":GOTO 2420
4220 XV$=XV$+"8":GOTO 2420
4230 XV$=XV$+"9":GOTO 2420
4240 XV$=XV$+"4":GOTO 2420
4250 XV$=XV$+"5":GOTO 2420
4260 XV$=XV$+"6":GOTO 2420
4270 XV$=XV$+"1":GOTO 2420
4280 XV$=XV$+"2":GOTO 2420
4290 XV$=XV$+"3":GOTO 2420
4300 XV$=XV$+".":GOTO 2420
4310 XV$=XV$+"0":GOTO 2420
5000 REM RETRIEVE FUNCTIONS
5010 IF Y>3 AND X<5 THEN GOTO 5030
5020 XA=VAL(XV$): XV$=""
5030 ON Y GOSUB 5070,5090,5110,5130,5150,5170,5190
5040 IF Y>3 AND X<5 THEN GOTO 5060
5050 GOSUB 2610
5055 XV$=STR$(XA)
5057 IF XV$="0" THEN XV$=""
5060 RETURN
5070 ON LU(1,X)GOSUB 3010,3070,3120,3170
5080 RETURN
5090 ON LU(2,X)GOSUB 3220,3430,3510,3590
5100 RETURN
5110 ON LU(3,X)GOSUB 3670,3720,3770,3870
5120 RETURN
5130 ON LU(4,X)GOSUB 4210,4220,4230,4160,3930,4110
5140 RETURN
5150 ON LU(5,X)GOSUB 4240,4250,4260,4170,3950,4030
5160 RETURN
5170 ON LU(6,X)GOSUB 4270,4280,4290,4180,3970,4050
5180 RETURN
5190 ON LU(7,X)GOSUB 4300,4310,4140,4190,4010,4070
5200 RETURN
6010 DATA" CALCULATOR HELP "
6020 DATA" "
6030 DATA" 2ND SHIFTS BETWEEN UPPER AND "
6040 DATA" FNC LOWER FUNCTIONS "
6050 DATA" (LETTER F IS EQUILIVANT) "
6060 DATA" "
6070 DATA" 10X COMMON INVERSE LOGARITHM OF X "
6080 DATA" LOG COMMON LOGARITHM OF X "
6090 DATA" "
6100 DATA" EX NATURAL INV. LOGARITHM OF X "
6110 DATA" LN NATURAL LOGARITHM OF X "
6120 DATA" "
6130 DATA" [255] ASSIGNS 3.1415927 TO X "
6140 DATA" RND RETURNS NORMAL DISTRIBUTION "
6150 DATA" RANDOM NUMBER BETWEEN 0 AND 1"
6160 DATA" TO X "
6170 DATA" P[209]R POLAR TO RECTANGULAR CONVERTE"
6180 DATA" D[209]R DEGREE TO RADIAN CONVERSION "
6190 DATA" "
6200 DATA" S-1 INVERSE SINE FUNCTION OF X "
6210 DATA" SIN SINE FUNCTION OF X "
6230 DATA" PRESS <ANY KEY> TO CONTINUE "
6240 DATA" PRESS <Q> TO QUIT "
6300 DATA" "
6310 DATA" CALCULATOR HELP "
6320 DATA" "
6330 DATA" C-1 INVERSE COSINE FUNCTION OF X"
6340 DATA" COS COSINE FUNCTION OF X "
6350 DATA" "
6360 DATA" T-1 INVERSE TANGENT FUNCTION OF X"
6370 DATA" TAN TANGENT FUNCTION OF X "
6380 DATA" "
6390 DATA" Y1X XTH ROOT OF Y VALUE "
6400 DATA" Y^X Y EXPONET X VALUE "
6410 DATA" "
6420 DATA" SQR SQUARE ROOT OF X "
6430 DATA" X^2 X VALUE SQUARED "
6440 DATA" "
6450 DATA" N! FACTORIAL OF X VALUE "
6460 DATA" CE CLEAR ENTRY "
6470 DATA" "
6480 DATA" 1/X RECIPORCAL OF X VALUE "
6490 DATA" Y[209]X SWITCH X AND Y VALUE "
6500 DATA" "
6520 DATA" PRESS <ANY KEY> TO CONTINUE "
6530 DATA" PRESS <Q> TO QUIT "
6540 DATA" "
6600 DATA" "
6610 DATA" CALCULATOR HELP "
6620 DATA" "
6630 DATA" F[209]E FLOATING POINT TO SCIENTIFIC "
6640 DATA" "
6650 DATA" Y=X X IS ASSIGNED TO Y AND ZEROED"
6660 DATA" "
6670 DATA" X[209]M X VALUE IS PUT INTO MEMORY "
6680 DATA" ZERO X VALUE CLEARS MEMORY "
6690 DATA" "
6700 DATA" RCL RECALL MEMORY TO X "
6710 DATA" "
6720 DATA" ME+ ADDS MEMORY TO X VALUE AND "
6730 DATA" STORES RESULT IN MEMORY "
6740 DATA" "
6750 DATA" +/- CHANGES SIGN OF X "
6760 DATA" "
6770 DATA" CLR CLEARS CALCULATOR "
6780 DATA" (LETTER C IS EQUALIVANT) "
6790 DATA" "
6800 DATA" % DIVIDES X BY 100 "
6810 DATA" "
6820 DATA" PRESS <ANY KEY> TO CONTINUE "
6830 DATA" PRESS <Q> TO QUIT "
6840 DATA" "
6850 FOR I=1 TO 3
6860 FOR J = 1 TO 24
6870 READ HE$(I,J)
6880 NEXT J:NEXT I
6890 RETURN
7000 PRINT"[147]";:POKE 53280,1:POKE 53281,1
7010 PRINT"[144]":BB=1
7030 PRINT"[147]"
7040 FOR H = 1 TO 24
7045 PRINT HE$(BB,H)
7050 NEXT H
7060 GET R$:IF R$="" THEN GOTO 7060
7070 IF R$="Q" THEN GOTO 7110
7080 BB=BB+1
7090 IF BB > 3 THEN BB =1
7100 GOTO 7030
7110 PRINT"[147]";:POKE 53280,0:POKE 53281,0
7120 PRINT""
7130 FOR T = 1 TO 22
7140 PRINT" ";CA$(T)
7150 NEXT T
7155 PRINT" PRESS <Q> TO QUIT";
7160 Y=1:X=1
7170 POKE 782,13:POKE 781,6:SYS 65520
7180 PRINT"";KE$(X,Y);"[146]"
7190 POKE 55404,2
7200 RETURN
9000 PRINT"[147][158]":POKE 53280,0:POKE 53281,0
9002 PRINT"[213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]
9110 [153]"PEEK SCIENTIFIC CALCULATOR PEEK"
9120 [153]"PEEK PEEK"
9130 [153]"PEEK ANOTHER FINE PRODUCT PEEK"
9133 [153]"PEEK PEEK"
9140 [153]"PEEK FROM PEEK"
9142 [153]"PEEK PEEK"
9144 [153]"CHR$ 'NEVER WORKS ELECTRONICS!' SYS PEEK"
9145 [153]"PEEK PEEK"
9150 [153]"PEEK JOSH30 AND HELENH PEEK"
9155 [153]"MID$LENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLEN(null)"
9160 [153]:[153]:[153]
9170 [153]" ARROW KEYS MOVE BUTTONS"
9180 [153]" <RETURN> SELECTS FUNCTION"
9190 [153]" <F> TOGGLES 2ND FUNCTION KEY"
9200 [153]" <C> CLEARS CALCULATOR"
9210 [153]" <?> HELP
9220 PRINT:PRINT:PRINT" PRESS <ANY KEY> TO BEGIN"
9230 GET A$:IF A$="" THEN GOTO 9230
9240 RETURN
62000 SAVE"CALC",8:SAVE"CALC-BKUP",8